perm filename PT2D.KLF[RST,LCS] blob sn#244646 filedate 1976-10-28 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE PT2
C00010 ENDMK
CāŠ—;
	SUBROUTINE PT2
	INTEGER VALID
	DIMENSION VALID(6),BARS(1),JBAR(1),JRN(1),MBAR(1)
	DATA QLINE/140.0/,HX/2./,VALID/1,4,8,2,3,-2/,SLSP/11.0/,DIV/4./
C  QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.

C  ADD MORE TO VALID LATER *****
	COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
	1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 
	COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
	1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) /KBAR/KBAR(512) 
	1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T
	COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
	COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/IV(1) /SIZE/SIZE
	COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
	1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
	1,(R8,RQ(6)),(R9,RQ(7)),(JRN,RN),(MBAR,RN(1000))
	1,(LCNT,IV(45)),(NDPY,IV(46)),(TOT,KBAR(2)),(JBAR,BARS,KBAR(4))
C  TRNSP'S Bb, F, BBb, A, G, Eb.
145	FORMAT(F,2I)
CCC	IF(RS.NE.'OLD')GO TO 2000
	CALL GETFIL('BARS')
	CALL FASTIN(KBAR,512)
	CALL FASTIN(RSTFAC,128)
2000	TYPE 144,RSTJ2
CC144	FORMAT(' STAFF SIZE, TRANSP.  '$)
144	FORMAT(' STAFF SIZE='F4.2,'  CHANGE TO '$)
	ACCEPT 145,SIZE,LL
	IF(SIZE.NE.0)GO TO 101
	SIZE=1
CC	GO TO 33
101	DO 22 K=1,KT
22	JBAR(K)=BARS(K)*SIZE+.5
	TOT=TOT*SIZE
33	IF(RSTJ2.EQ.0)RSTJ2=1 
	RA=JPG*SIZE*RSTJ2
	MPG=10./RA
C  MPG=NUM OF BRACES PER PAGE.
	SPG=10./MPG
C  SPG IS SPACE TO BE SET ABOVE STAFF 0
	RA=(RSTJ2*SIZE)/RPSZ(1)
	DO 141 K=1,JPG
141	RPSZ(K)=RPSZ(K)*RA
	LPG=JPG
	IF(MOD(LL,7).EQ.0)GO TO 140
	DO 40 L=1,6
40	IF(LL.EQ.VALID(L))GO TO 140
	TYPE 240
	GO TO 2000
240	FORMAT(' THIS TRANSP NOT OFFERED')

140	TYPE 90,KT
	RA=0
90	FORMAT(' TOTAL BAR LINES='I3/' NUMBER OF BARS PER LINE')
	
	JT=TOT/QLINE
C  USE QLINE (140 FOR NOW) AS SUGGESTED LINE LENGTH
16	MAX=0
	MIN=10000
	NT=JT
	L=0
	KLEF=0
	JTOT=TOT+.5
	JTOT=JTOT+6*(JT-1)
	KAV=JTOT/JT

	LMAX=10000
	NBAR(1)=1
	J=1
3	M=1
	JAV=JTOT/NT
C  ADD SPACE FOR CLEFS (6) AFTER 1ST LINE
	IF(JAV.GT.KAV)JAV=JAV-2
 	IF(JAV.LT.KAV)JAV=JAV+2
	K=JBAR(J)
1	J=J+1
	IF(J.GT.KT)GO TO 2
	N=JBAR(J)
	IF(K+N/2.GE.JAV)GO TO 2
	M=M+1
	K=K+N
	GO TO 1
2	L=L+1
	K=K+KLEF
	JTOT=JTOT-K
	NT=NT-1
	JRN(L)=K
	KLEF=6
C  AFTER 1ST LINE, ADD SOME SPACE FOR CLEFS.
	NBAR(L+1)=J
	IF(NT.NE.0)GO TO 3
5	MAX=0
	MIN=10000

	DO 7 L=1,JT
	K=JRN(L)
	IF(K.LE.MAX)GO TO 6
	MAX=K
	MX=L
6	IF(K.GE.MIN)GO TO 7
	MIN=K
	MN=L
7	CONTINUE

	IF(MAX.GE.LMAX)GO TO 9
	LMAX=MAX
	DO 8 J=1,JT+1
C  SAVE NBAR INFO IN MBAR
8	MBAR(J)=NBAR(J)

	IF(MX.LT.MN)GO TO 32
	JJ=0
	JM=-1
	JK=1
23	K=NBAR(MX+JJ)-JJ
C NEXT RIPPLES THE BARS, FROM MAX TO MIN.
	MM=JBAR(K)
	JRN(MX)=JRN(MX)-MM
	JRN(MX+JM)=JRN(MX+JM)+MM
	NBAR(MX+JJ)=K+JK
	MX=MX+JM
	IF(JJ.NE.0)GO TO 223
	IF(MX.GT.MN)GO TO 23
	GO TO 5 
223	IF(MX.LT.MN)GO TO 23
	GO TO 5 
32	JJ=1
	JM=1
	JK=0
	GO TO 23
9	MBAR(JT+1)=KT+1
	KLEF=0
	DO 10 K=1,JT
	N=MBAR(K)
	M=MBAR(K+1)
 	NBAR(K)=N
	JJ=0
	DO 15 J=N,M-1
15	JJ=JJ+JBAR(J)
	JRN(K)=JJ+KLEF
10	KLEF=6
13	DO 14 L=2,JT
	K=NBAR(L)
	MM=JRN(L)
	KK=JRN(L-1)
	IF(MM.GE.KK)GO TO 12
C  JUGGLES ADJACENT LINES
	N=JBAR(K-1)
	IF(KK-MM.LT.N)GO TO 14
	JRN(L-1)=KK-N
	JRN(L)=MM+N
	NBAR(L)=K-1
	GO TO 13
12	N=JBAR(K)
	IF(MM-KK.LE.N)GO TO 14
	JRN(L-1)=KK+N
	JRN(L)=MM-N
	NBAR(L)=K+1
	GO TO 13
14	CONTINUE
46	J=1
	NBAR(JT+1)=KT+1
	JTOT=TOT+.5
	JTOT=JTOT+6*(JT-1)
C  ADD SPACE FOR CLEFS (6) AFTER 1ST LINE
	JAV=JTOT/JT
	TYPE 306,JAV
	GO TO 307
	PRINT 306,JAV
307	DO 305 K=1,JT
	NBAR(K)=NBAR(K+1)-NBAR(K)
C NBAR NOW HAS NUM. OF BARS PER LINE.
	L=NBAR(K)-1+J
306	FORMAT(I5,3X8I5)
C  AFTER FIRST LINE 6 IS ADDED FOR CLEF SPACE.
	TYPE 306,JRN(K),(JBAR(N),N=J,L)
	GO TO 305
	PRINT 306,JRN(K),(JBAR(N),N=J,L)
305	J=L+1
	NBAR(JT+1)=0
	
	RPG=JT
	RPG=RPG/MPG
105	TYPE 104,RPG,JT
	GO TO 104
	PRINT 104,RPG,JT
104	FORMAT(F5.2,' PAGES',/,I4,' LINES - OR TYPE N1, N2 --'$)
C  FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE
	KA=0
	ACCEPT 145,T,N,KL
C  TYPE 0,n  TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
	IF(KL.NE.0)GO TO 110
C NO MORE THAN 36 NUMS, INCLUDING 0S (FOR PAGE MARKS)
	IF(T.EQ.0)GO TO 11
	JT=T
	IF(N.EQ.0)GO TO 16
C N=0 MEANS T= NUM OF LINES DESIRED.

111	FORMAT(36I)
110	REREAD 111,NBAR
911	DO 112 K=36,1,-1
	KP=NBAR(K)
	KA=KA+KP
112	IF(KP.EQ.0.AND.KA.EQ.0)KL=K
	IF(KA.NE.KT)GO TO 105
C  MISMATCH!
	N=26-2*MOD(KL-1,12)
	IF(N.EQ.26)N=0
C  TO SPACE OUT STAVES VERTICALLY
CC	IF(IPG)GO TO 11
CC	IF(NBAR(1).NE.0)GO TO 11
CC	DO 711 K=1,36
CC	IF(K.GT.J)IV(K)=0
CC711	NBAR(K)=IV(K)
CC	GO TO 911
11	CALL WRTPAG
	END